CU Amiga Super CD-ROM 14/CU Amiga Magazine's Super CD-ROM 14 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-09].iso/CUCD/Online/News/Thor/HD-Install/thor24_arexx.lha/SpreadEvent.thor

Text File | 1996-11-11 | 5.3 KB | 201 lines

/* SpreadEvent.thor by Sigbjørn Skjæret
** $VER: SpreadEvent.thor v1.21 (05.06.95)
**
** Copies events to other BBSes...
*/

options results

p = ' ' || address() || ' ' || show('P',,)
thorport = pos(' THOR.',p)

if thorport > 0 then thorport = word(substr(p,thorport+1),1)
else
do
    say 'No THOR port found!'
    exit 10
end

if ~show('p', 'BBSREAD') then
do
    address command
        "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
        "WaitForPort BBSREAD"
end

address(thorport)

CURRENTBBS stem CURRENT
if(rc ~= 0) then
do
 REQUESTNOTIFY TEXT '"'"Error:" upper(left(THOR.LASTERROR, 1)) || delstr(THOR.LASTERROR, 1, 1)'"' BT '"_OK"'
 exit
end

GETSELECTEDEVENT
if(rc ~= 0) then
do
 REQUESTNOTIFY TEXT '"No selected event."' BT '"_OK"'
 exit
end

event = result

address BBSREAD READBREVENT '"'CURRENT.BBSNAME'"' event datastem EVENTDATA tagsstem EVENTTAGS
if(rc ~= 0) then
do
 REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
 exit
end

/*
EVE_ENTERMSG     =  0  - Enter message
EVE_REPLYMSG     =  1  - Reply message
EVE_JOINCONF     =  2  - Join conference
EVE_RESIGNCONF   =  3  - Resign conference
EVE_DOWNLOAD     =  4  - Download file
EVE_UPLOAD       =  5  - Upload file
EVE_CONFLIST     =  6  - Get conflist
EVE_CONFIGUREBBS =  7  - Set correct configuration on the bbs
EVE_SENDUSERINFO =  8  - Send userinfo
EVE_GETMESSAGES  =  9  - Get specified messages
EVE_GETNEWFILES  = 10  - Get new files listing
EVE_DOCOMMAND    = 11  - Command the script should do
EVE_AUTOLOGOFF   = 12  - Autologoff on next session
*/

if(EVENTDATA.EVENTTYPE = 1 | EVENTDATA.EVENTTYPE = 2 | EVENTDATA.EVENTTYPE = 3 | EVENTDATA.EVENTTYPE = 9) then
do
 REQUESTNOTIFY TEXT '"This eventtype is not supported for obvious reasons!"' BT '"_Ok, smartypants!"'
 exit
end

if(EVENTDATA.EVENTTYPE = 4) then
do
 REQUESTNOTIFY TEXT '"Why would you want to do that?"' BT '"_Ok, my fault!"'
 exit
end

if(EVENTDATA.EVENTTYPE = 5) then
do
 REQUESTNOTIFY TEXT '"I''m only doing this because you''ve been so nice!\nUse MultiUpload.thor next time..."' BT '"_Ok, I''ll do that!"'
 if(EVENTTAGS.CONFERENCE ~= 'EVENTTAGS.CONFERENCE') then getconf = 1
end

if(EVENTDATA.EVENTTYPE = 0) then getconf = 1

do forever
 call DoThing

 do i = 1 to TOBBS.COUNT
  if(getconf = 1) then EVENTTAGS.CONFERENCE = TOCONF.i

  if(EVENTTAGS.MSGFILE ~= 'EVENTTAGS.MSGFILE') then
  do
   drop BBSDATA
   address BBSREAD GETBBSDATA '"'CURRENT.BBSNAME'"' stem BBSDATA
   if(rc ~= 0) then
   do
    REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
    exit
   end

   address BBSREAD UNIQUEMSGFILE '"'TOBBS.i'"' stem MSG
   if(rc ~= 0) then
   do
    REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
    exit
   end

   address command "copy" '"'BBSDATA.BBSPATH || EVENTTAGS.MSGFILE'"' '"'MSG.NAME'"' "QUIET NOREQ"

   EVENTTAGS.MSGFILE = MSG.FILEPART
  end

  if(EVENTTAGS.DETAILEDFILEDESCR ~= 'EVENTTAGS.DETAILEDFILEDESCR') then
  do
   drop BBSDATA
   address BBSREAD GETBBSDATA '"'CURRENT.BBSNAME'"' stem BBSDATA
   if(rc ~= 0) then
   do
    REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
    exit
   end

   address BBSREAD UNIQUEMSGFILE '"'TOBBS.i'"' stem MSG
   if(rc ~= 0) then
   do
    REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
    exit
   end

   address command "copy" '"'BBSDATA.BBSPATH || EVENTTAGS.DETAILEDFILEDESCR'"' '"'MSG.NAME'"' "QUIET NOREQ"

   EVENTTAGS.DETAILEDFILEDESCR = MSG.FILEPART
  end

  address BBSREAD WRITEBREVENT '"'TOBBS.i'"' EVENTDATA.EVENTTYPE stem EVENTTAGS
  if(rc ~= 0) then
  do
   REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
   exit
  end

  PACKEVENTS '"'TOBBS.i'"'
  if(rc ~= 0) then
  do
   REQUESTNOTIFY TEXT '"'"Error:" upper(left(THOR.LASTERROR, 1)) || delstr(THOR.LASTERROR, 1, 1)'"' BT '"_OK"'
   exit
  end

  drop EVENTDATA
  drop EVENTTAGS
  address BBSREAD READBREVENT '"'CURRENT.BBSNAME'"' event datastem EVENTDATA tagsstem EVENTTAGS
  if(rc ~= 0) then
  do
   REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
   exit
  end
 end
end

DoThing:
drop BBSLIST
address BBSREAD GETBBSLIST stem BBSLIST
if(rc ~= 0) then
do
 REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
 exit
end

drop TOBBS
drop TOCONF
REQUESTLIST instem BBSLIST outstem TOBBS title '"Select BBS to copy event to"' MULTISELECT
if(rc ~= 0) then
do
 if(rc ~= 5) then REQUESTNOTIFY TEXT '"'"Error:" upper(left(THOR.LASTERROR, 1)) || delstr(THOR.LASTERROR, 1, 1)'"' BT '"_OK"'
 exit
end

do i = 1 to TOBBS.COUNT
 if(getconf = 1) then
 do
  address BBSREAD GETCONFLIST bbsname '"'TOBBS.i'"' stem CONFLIST
  if(rc ~= 0) then
  do
   REQUESTNOTIFY TEXT '"'"Error:" upper(left(BBSREAD.LASTERROR, 1)) || delstr(BBSREAD.LASTERROR, 1, 1)'"' BT '"_OK"'
   exit
  end

  REQUESTLIST instem CONFLIST outstem CONF title '"Select Conference"'
  if(rc ~= 0) then
  do
   if(rc ~= 5) then REQUESTNOTIFY TEXT '"'"Error:" upper(left(THOR.LASTERROR, 1)) || delstr(THOR.LASTERROR, 1, 1)'"' BT '"_OK"'
   exit
  end

  TOCONF.i = result

 end
end